perm filename STRUCT[NEW,LSP]2 blob
sn#388710 filedate 1978-10-11 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00026 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 -*-MIDAS-*-
C00005 00003
C00007 00004
C00009 00005
C00013 00006
C00015 00007
C00018 00008
C00022 00009
C00024 00010
C00026 00011
C00030 00012
C00034 00013
C00036 00014
C00039 00015
C00041 00016
C00044 00017
C00046 00018
C00049 00019
C00053 00020
C00055 00021
C00058 00022
C00061 00023
C00063 00024
C00066 00025
C00068 00026
C00069 ENDMK
C⊗;
;;; -*-MIDAS-*-
;;; **************************************************************
;;; ***** MACLISP ****** INITIAL LIST STRUCTURE ******************
;;; **************************************************************
;;; ** (C) COPYRIGHT 1978 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;; **************************************************************
SUBTTL MACROS FOR CREATING INITIAL LIST STRUCTURE
PFXEST==3200 ;ESTIMATED SPACE NEEDED FOR PURE FIXNUMS
SFA$ SYMEST==1100 ;ESTIMATED INITIAL NUMBER OF LISP SYMBOLS
SFA% SYMEST==1000
LSYALC==20
GSNSYSG==<SYMEST+SEGSIZ-1>/SEGSIZ ;GUESS AT THE NUMBER OF SYM SEGS NEEDED
GSNSY2==<<SYMEST*2>+SEGSIZ-1>/SEGSIZ ;GUESS AT THE NUMBER OF SY2 SEGS NEEDED
GSNPFXSG==<PFXEST+SEGSIZ-1>/SEGSIZ ;GUESS AT THE NUMBER OF PFX SEGS NEEDED
MAYBE NXVCSG==<ITS\D20>*2000/SEGSIZ
.NSTGWD ;NO STORAGE WORDS OVER MACRO DEFINITIONS
KNOB==0 ;NUMBER OF OBJECTS FOR OBARRAY
.XCREF KNOB
DEFINE PUTOB A
20% ADDOB \A-.RL1,\KNOB
20$ ADDOB \A,\KNOB
TERMIN
DEFINE ADDOB A,N
DEFINE OB!N
20% .RL1+A
20$ A
TERMIN
KNOB==KNOB+1
TERMIN
;;; STANDARD FUNCTION MAKERS
;;; MKAT <PNAME/INTERNAL-NAME>,<PROP-NAME>,<SPACE-FOR-Q-LABEL>,<ARGS-PROP>
;;; MKAT1 <PNAME>,<PROP-NAME>,<SPACE-FOR-Q-LABEL>,<INTERNAL-NAME>,<ARGS-PROP>
DEFINE MKAT A,B,C,D
Q!B %
A,,
RMTAH1 [C]A,PNL-2,[A]D,SUNBOUND,100
TERMIN
DEFINE MKAT1 A,B,C,D,E
Q!B %
D,,
RMTAH1 [C]D,PNL-2,[A]E,SUNBOUND,100
TERMIN
;;; MKAT2 USED TO CREATE AUTOLOAD ATOMS
;;; MKAT2 <ATOM-NAME>,<BRIEF-NAME-FOR-AUTOLOAD-PROP>,<LABEL-FOR-HEADER>
DEFINE MKAT2 A,D,C
QAUTOLOAD %
QFL.!D,,
IFSN [C], MKAT2A [A]C
IFSE [C], MKAT2A [A]A
TERMIN
DEFINE MKAT2A PN,D
RMTAH1 [ ]D,PNL-2,[PN],SUNBOUND,100
TERMIN
;;; MAKES AN ATOM WITH A VALUE CELL, BUT NO OTHER PROPERTIES
;;; MKAV <PNAME>,<LABEL-FOR-VCELL>,<CONTENTS-OF-VCELL>,<LABEL-FOR-HEADER>
DEFINE MKAV A,B,C,D
IFSN [D], RMTAH1 [ ]D,,A,,C.,100
IFSE [D], RMTAH1 ,,,A,,C.,100
C..==.
LOC C.
IFSN [B], B:
.ELSE, V!A:
IFSN [C], C
.ELSE, NIL
C.==.
LOC C..
TERMIN
;;; MAKES A FUNCTION WITH A VALUE CELL
;;; MKFV <PNAME>,<INTERNAL-NAME>,<PROP-NAME>,<INITIAL-VALUE>,<ARGS-PROP>
DEFINE MKFV A,B,C,D,E
Q!C %
B,,
RMTAH1 [ ]B,PNL-2,[A]E,V!B,100
RMTVC V!B,D
TERMIN
;;; STRINGS TOGETHER THE WORDS OF A PNAME INTO A LIST
DEFINE APN,PN
(F.)!REPEAT <<.LENGTH }PN}>+4>/5-1,[%
(F.+.RPCNT+1)]
PNL==.
LOC F.
ASCII }PN}
F.==.
LOC PNL
TERMIN
;;; MAKES A "SYSTEM" ATOM. USUSALLY HAS NO PROPERTIES.
;;; MSA <INTERNAL-NAME>,<PNAME>
DEFINE MSA LN,PN
RMTAH1 [ ]LN,,PN,,SUNBOUND,100
TERMIN
;;; MAKE A "RANDOM ATOM" (OR ATOMS)
DEFINE MRA PNS
IRP PN,,[PNS]
MSA PN,PN
TERMIN
TERMIN
;;; C = <SPACE> MEANS THAT WE SHOULD HAVE A LABEL FOR THE HEADER
;;; D IS THE LABEL, MORE OR LESS, IF C IS A <SPACE>
;;; PL IS FLAG FOR PROPERTY LIST. IF NULL, THEN NIL [= 0] GETS
;;; ASSEMBLED. OTHERWISE, IT MUST BE "PNL-2", SINCE THE PROPERTY
;;; LIST WILL ALWAYS HAVE 2 CELLS JUST PRECEEDING THE PNAME-LIST
;;; PN IS THE PNAME STRING, AR THE ARGS PROPERTY, V THE LABEL OF THE VALUE CELL
DEFINE RMTAH1 C,D,PL,PN,AR,V,UC
PNL==.
LOC S.
PUTOB .
IFSE [C] , Q!D:
B.,,PL
S.==.
LOC B.
UC\777200,,V
NN!AR,,PNL
B.==.
LOC PNL
APN [PN]
TERMIN
;;; REMOTE VALUE CELL MAKER
DEFINE RMTVC A,C
ZZ==.
LOC C.
A:
IFSN [C], C
.ELSE, NIL
C.==.
LOC ZZ
TERMIN
;;; ARGS TO IRP IN GROUPS OF 4 FOR EASY COUNTING
IRP Q,,[0,,1,2
3,4,5,01
12,23,16,36
08,1777,2777,02
13,34,35,45
03,27,37,04
3777,17]R,,[1,0,2,3
4,5,6,1002
2003,3004,2007,4007
1011,2777,3777,1003
2004,4005,4006,5006
1004,3010,4010,1005
4777,2010]
NN!Q==R
TERMIN ;FOR BIBOP ARGS PROPERTIES
SUBTTL STARTS FOR SAR, VC, IS2, AND SYM [SYMBOL-HEADER] SPACES
;;; STATE OF THE WORLD HERE HAD BETTER BE
;;; 1) LOSEG IF IN D10
;;; 2) BEGINNING ON A SEGMENT BOUNDARY
.XCREF RMTAH1 MKAT MKAT1 MKAT2 MKAV MKFV RMTVC MSA
.XCREF MKAT2A
.YSTGWD ;STORAGE WORDS ARE OKAY NOW
PGBOT ATM
BLSTIM==.MRUNT
;;; FORMAT OF SYMBOL HEADER FOR BIBOP:
;;; THE MAIN HEADER OF A SYMBOL IS A SINGLE WORD IN SYMBOL SPACE.
;;; THE RIGHT HALF CONTAINS THE PROPERTY LIST, AND THE LEFT HALF
;;; POINTS TO THE REST OF THE HEADER, WHICH IS IN THE IS2 OR SY2 AREA.
;;; SINCE THE REST OF THE HEADER (ALSO CALLED A "SYMBOL BLOCK") MUST
;;; LIE ON AN EVEN WORD BOUNDARY, THE LOW BIT OF THE LEFT HALF OF
;;; THE MAIN HEADER IS NORMALLY ZERO. THIS BIT IS USED BY THE
;;; GARBAGE COLLECTOR FOR MARKING PURPOSES, AND THEN RESET TO ZERO.
;;; THE SYMBOL BLOCK IS 2 WORDS LONG:
;;; <VARIOUS BITS>,,<POINTER TO VALUE CELL>
;;; <ARGS PROPERTY>,,<PNAME LIST>
;;; THE "VARIOUS BITS" ARE:
;;; 4.9-3.9 ONES (FOR NO PARTICULARLY GOOD REASON)
;;; 3.9 ZERO (RESERVED FOR SPECIAL VALUE CELL/LAP HACK)
;;; 3.8 1 => SYMBOL BLOCK MAY BE PURE (SEE GCMARK)
;;; 3.7 ONE IFF COMPILED CODE NEEDS THE SYMBOL
;;; 3.6 ONE IFF COMPILED CODE REFERENCES BY OTHER THAN CALL UUO
;;; (IMPLIES 3.7 WHICH *MUST* ALSO BE ON)
;;; 3.5-3.1 ZERO (SO CAN INDIRECT THROUGH THE WORD TO GET VALUE)
;;; THE ARGS PROPERTY IS IN THE SAME FORMAT FASLOAD USES,
;;; TWO NINE-BIT BYTES DECODED AS FOLLOWS:
;;; 0 => NIL
;;; 777 => 777 (EFFECTIVELY INFINITY)
;;; N => N-1, N NOT 0 OR 777
;;; THUS 000006 = (NIL . 5), 004005 = (3 . 4), AND 002777 = (1 . 777)
SPCBOT SAR
DEDSAR: 0,,ADEAD ;DEAD SAR (PROTECTED BY GC)
TTDEAD
DBM: 0,,ADEAD ;DEAD BLOCK MARKER
TTDEAD
BSYSAR==. ;BEGINNING OF "SYSTEM" ARRAY PROPS (SEE SYSP)
OBARRAY: AS<OBA+SX+GCP>,,IOBAR1 ;OBARRAY
TTS<1D+CN>,,IOBAR2(TT)
READTABLE: AS<RDT+FX>,,RSXTB1 ;READTABLE
TTS<1D+CN>,,RCT(TT)
PRDTBL: AS<RDT+FX>,,RSXTB2 ;PURE READTABLE
TTS<1D+CN>,,RCT0(TT)
IFN QIO,[
TTYIFA: AS<FIL+SX+GCP>,,TTYIF1 ;TTY INPUT FILE ARRAY
TTS<1D+CL+CN+TY>,,TTYIF2(TT)
TTYOFA: AS<FIL+SX+GCP>,,TTYOF1 ;TTY OUTPUT FILE ARRAY
TTS<1D+CL+CN+TY+IO>,,TTYOF2(TT)
INIIFA: AS<FIL+SX+GCP>,,INIIF1 ;INIT FILE ARRAY
TTS<1D+CL>,,INIIF2(TT)
] ;END OF IFN QIO
ESYSAR==.
SPCTOP SAR,ILS,[SAR]
;;; BEGINS ON A SEGMENT BOUNDARY, BECAUSE OF THE "SPCTOP SAR"
SPCBOT VC
C.==. ;LOCATION COUNTER FOR VALUE CELL SPACE
;;; NOTE THAT VALUE CELLS FOR T, NIL, UNBOUND, AND UBAR
;;; ARE IN PURE FREE STORAGE
BLOCK 400
SEGUP .
BXVCSG==.
IFN NXVCSG,[
PAGEUP
BXVCSG==.
LOC .+NXVCSG*SEGSIZ-1
PAGEUP
]
EVCSG==.
SPCBOT IS2
SY2ALC:
LOC .+2*LSYALC
SPCTOP IS2,ILS,[IMPURE SYMBOL BLOCK]
SPCBOT SYM
SYMSYF:: ;FIRST LOC OF SYSTEM SYMBOLS
TRUTH: $$$TRUTH,,NIL ;ATOM HEADER FOR T
PUTOB TRUTH
20% ADDOB -.RL1+NIL,\KNOB
20$ ADDOB NIL,\KNOB
;;; CROCK TO PUTOB NIL CORRECTLY
;;; THESE FIVE SYMBOLS ARE **NOT** ON THE OBARRAY
QUNBOUND: $$$UNBOUND,,NIL ;INTERNAL UNBOUND MARKER
IFN EDFLAG,[
EDLP: $$$EDLP,,NIL
EDRP: $$$EDRP,,NIL
EDSTAR: $$$EDSTAR,,NIL
] ;END OF IFN EDFLAG
SYALC: BLOCK LSYALC ;FOR ALLOC
S.==. ;LOCATION COUNTER FOR SYMBOL SPACE
SEGUP BSYMSG+GSNSYSG*SEGSIZ-1
;END OF SYMBOL GUESS
ESYMGS==.
PAGEUP
SUBTTL STARTS FOR SY2, PFX, AND PFS [PURE LIST] SPACES
10$ $HISEG
SPCBOT SY2
$$$TRUTH: 777300,,VTRUTH
0,,$$TRUTH
$$$UNBOUND: 777300,,SUNBOUND
0,,$$UNBOUND
IFN EDFLAG,[
$$$EDLP: 777300,,SUNBOUND
0,,$$EDLP
$$$EDRP: 777300,,SUNBOUND
0,,$$EDRP
$$$EDSTAR: 777300,,SUNBOUND
0,,$$EDSTAR
] ;END OF IFN EDFLAG
B.==. ;LOCATION COUNTER FOR SYMBOL BLOCK SPACE
SEGUP BSY2SG+GSNSY2*SEGSIZ-1
SPCBOT PFX
INR70: R70
F.==. ;LOCATION COUNTER FOR PURE FIXNUMS - USED FOR PNAMES AND INUMS
SEGUP BPFXSG+GSNPFXSG*SEGSIZ-1
EPFXGS==.
SPCBOT PFS
BPURFS==. ;BEGINNING OF PURE FS (FOR INSERT FILE PAGE)
;;; FREE STORAGE STUFF THAT IS NEVER GC'ED, NOR DARE MARKED FROM (NON-BIBOP)
$$UNBOUND:
APN UNBOUND
$$NIL: ;PNAME FOR NIL
APN NIL
VNIL: NIL ;NIL'S VALUE CELL IS IN PFS - THAT WAY YOU CAN'T SETQ IT
$$TRUTH: ;PNAME OF T
APN T
VT:
VTRUTH: TRUTH ;LIKEWISE CAN'T SETQ T
;;; STANDARD UNBOUND VALUE CELL - POINTED TO BY ALL SYMBOLS WHICH
;;; DON'T HAVE THEIR OWN VALUE CELL. NOTE: ALL SUCH SYMBOLS ARE
;;; HELIOCENTRIC. MUST HAVE SUNBOUND ABOVE END OF VALUE CELL AREA
;;; - SEE GYSP5A AND SSYSTEM.
SUNBOUND: QUNBOUND
SSSBRL: QARRAY %
ASBRL: QAUTOLOAD %
SYSBRL: QARRAY,,SBRL
SBRL: QSUBR %
QFSUBR %
QLSUBR,,NIL
QGRTL: Q$GREAT,,NIL ;(>) FOR UGREAT
SUBTTL +INTERNAL FUNCTIONS AND INITIAL AUTOLOAD PROPERTIES
RDQTEB=RDQTE ;THE OTHERS WIN BECAUSE THEY ARE 6 CHARS
IRP X,,[RDQTE,RDSEMI,RDVBAR]Y,,[['],[;],[|]]
MKAT1 [+INTERNAL-Y-MACRO]SUBR,[ ]X!B,0
TERMIN
IFE QIO,[
MKAT1 +INTERNAL-TYO-MACRO,SUBR,[ ]TTYECOB
MKAT1 +INTERNAL-↑H-BREAK,SUBR,[ ]CN.HB
] ;END OF IFE QIO
IFN QIO,[
MKAT1 +INTERNAL-TTYSCAN-SUBR,SUBR,[ ]TTYBUF,3
MKAT1 +INTERNAL-↑Q-MACRO,SUBR,[ ]CTRLQ,0
MKAT1 +INTERNAL-↑S-MACRO,SUBR,[ ]CTRLS,0
MKAT1 +INTERNAL-↑B-BREAK,SUBR,[ ]CN.BB,2
MKAT1 +INTERNAL-IOL-BREAK,SUBR,[ ]IOLB,1
MKAT1 +INTERNAL-UREAD-EOFFN,SUBR,[ ]UREOF,2
MKAT1 +INTERNAL-INCLUDE-EOFFN,SUBR,[ ]INCEOF,2
MKAT1 +INTERNAL-TTY-ENDPAGEFN,SUBR,[ ]TTYMOR,1
] ;END OF IFN QIO
MKAT1 +INTERNAL-*RSET-BREAK,SUBR,[ ]CB,1
IRP X,,[UDF,UBV,WTA,UGT,WNA,GCL,FAC]
MKAT1 +INTERNAL-X-BREAK,SUBR,[ ]X!B,1
TERMIN
MKAT1 +INTERNAL-PDL-BREAK,SUBR,[ ]PDLB,1
MKAT1 +INTERNAL-GCO-BREAK,SUBR,[ ]GCOB,1
IFN NEWRD,[
;;;INITIAL ASSQ LIST OF MACRO-FUNCTIONS
PRMCLS: .+1,,.+2
47,,QRDQTE
.+1,,NIL
73,,QRDSEMI
] ;END OF IFN NEWRD
MKAT1 +INTERNAL-AUTOLOAD,SUBR,[ ]IALB
BSYSAP==. ;BEGINNING OF SYSTEM AUTOLOAD PROPERTIES
;;; NOTE THAT DUE TO THE 6-CHAR LOSS, GRINDEF HAD TO BECOME GFN IN THE LABEL
IRP A,,[GRIND,GFN,LAP,TRACE,GETMIDASOP,INDEX,SORT,LET,BAQAUL,FORMAT]B,,[GI,GE,LA,TR,GT,IN,SO,LM,BQ,FT]
QFL.!B: Q!A,,IRATBL
TERMIN
IFE EDFLAG, QFL.ED: QEDIT,,IRATBL
QFL.CG: QCGOL,,IRATBL
SA$ QFL.ER: QEREAD,,IRATBL
SA$ QFL.HE: QHELP,,IRATBL
IFN QIO,[
IFN USELESS, QFL.DA: QDUMPARRAYS,,IRATBL
IFN MOBIOF, QFL.MX: QMPX,,IRATBL
IFN ITS, QFL.DS: QSLAVE,,IRATBL
IFN ITS, QFL.NV: QNVID,,IRATBL
IFN ITS, QFL.LE: QLEDIT,,IRATBL
IFN ITS, QFL.LT: QLISPT,,IRATBL
IFN ITS, QFL.HM: QHUMBLE,,IRATBL
IFN USELESS, QFL.AL: QALLFILES,,IRATBL
] ;END OF IFN QIO
ESYSAP==. ;END OF SYSTEM AUTOLOAD PROPERTIES
IRATBL: QFASL % ;STANDARD FN2 AND DEVICE/DIRECTORY FOR AUTOLOAD FILES
IRACOM:
IT$ QDSK % ;ON ITS, DIR IS (DSK LISP)
IT$ QLISP,,NIL
IFN D10,[
IFN TOPS10,[
QSYS,,NIL ;ON TOPS-10: (SYS)
] ;END OF IFN TOPS10
IFN SAIL,[
QDSK % ;ON SAIL IT IS (DSK (MAC LSP))
.+1,,NIL
QMAC %
QLSP,,NIL
] ;END OF IFN SAIL
IFN CMU,[
QDSK % ;FOR NOW, USE JONL'S DIRECTORY ON CMU: (DSK N920JW51)
QN920JW51,,NIL
] ;END OF IFN CMU
] ;END OF IFN D10
IFN D20,[
QDSK % ;FOR D20 IT IS (DSK MACLISP)
QMACLISP,,NIL
] ;END OF IFN D20
IFE .-IRACOM, WARN [IRACOM UNDEFINED]
Q% QFASLL: QFASL,,NIL
SUBTTL RANDOM LIST STRUCTURE
IFN BIGNUM,[
BNM23A: IN0 %
IN1,,NIL
BNM23B: IN0 %
IN2,,NIL
BN.1A: IN0+1,,NIL
BNV2A: BNV1,,NIL
] ;END OF IFN BIGNUM
IFN EDFLAG,[
EDFUNL: QEXPR %
QFEXPR %
QMACRO,,NIL
$$EDLP:
APN [%I(%]
$$EDRP:
APN [%I)%]
$$EDSTAR:
APN [%D()%]
] ;END OF IFN EDFLAG
IFN QIO,[
QTLIST: TRUTH,,NIL
IFN ITS,[
QLSPOUT: Q.LISP. % ;FOR ITS, (/.LISP/. OUTPUT)
QOUTPUT,,NIL
] ;END OF IFN ITS
IFN D20,[
QLSPOUT: QMACLISP % ;FOR D20, (MACLISP OUTPUT)
QOUTPUT,,NIL
] ;END OF IFN D20
;QLSPOUT CONSTRUCTED AT RUN TIME FOR D10
QCOMDEV: IRACOM,,NIL
IFN ITS,[
QCOMDIR: .+1,,NIL
QDSK %
QCOMMON,,NIL
] ;END OF IFN ITS
] ;END OF IFN QIO
Q% PSUDOSPACE: 203,,NIL ;WHEN RDIN WANTS TO RETURN ONE SPACE.
QUWL: QUWRITE,,NIL
QURL: QUREAD,,NIL
LGOR: QGO %
QRETURN,,NIL
QNILSETQ: QSETQ % ;FOR NIHIL ERROR MESSAGE
.+1,,NIL
NIL,,NIL
QTSETQ: QSETQ % ;FOR VERITAS ERROR MESSAGE
.+1,,NIL
TRUTH,,NIL
QXSETQ: QSETQ % ;FOR PURITAS ERROR MESSAGE
QXSET1,,NIL
ARQLS: QARRAY % ;(ARRAY ?)
$QMLST: QM,,NIL ;LIST OF A QUESTION MARK: (?)
QSJCL: QSTATUS % ;(STATUS JCL)
QJCL,,NIL
SPCNAMES: ;(STATUS SPCNAMES)
QSYMBOL %
QARRAY %
PURSPCNAMES: ;(STATUS PURSPCNAMES)
QLIST %
REPEAT HNKLOG, CONC QHUNK,\.RPCNT+1,,,.+1
BG$ QBIGNUM %
DX$ QDUPLEX %
CX$ QCOMPLEX %
DB$ QDOUBLE %
QFLONUM %
QFIXNUM ,,NIL
PDLNAMES:
IRPS XX,Y,[REG FL FX SPEC]
Q!XX!PDL,,IFSE [Y][ ][.+1]
TERMIN
SUBTTL RANDOM SYSTEMIC ATOMS
;;; (LIST, FIXNUM, FLONUM, DOUBLE, COMPLEX, DUPLEX, BIGNUM,
;;; SYMBOL, <HUNKS>, RANDOM, ARRAY) MUST BE IN THAT ORDER
;;; (NOTE THAT THIS OVERLAPS THE NEXT LIST!)
COMMENT # QLIST: QFIXNUM: QFLONUM: QDOUBLE: QCOMPLEX: QDUPLEX:
QBIGNUM: QSYMBOL: QHUNK1: QRANDOM: QARRAY: #
MKAT LIST,LSUBR,[ ]
MRA FIXNUM
MRA FLONUM
DB$ MRA DOUBLE
CX$ MRA COMPLEX
DX$ MRA DUPLEX
BG$ MRA BIGNUM
MRA SYMBOL
IRP X,,[4,8,16,32,64,128,256,512,1024]
IFE .IRPCNT-HNKLOG, .ISTOP
CONC MSA HUNK,\.IRPCNT+1,,HUNK!X
TERMIN
MKAT RANDOM,LSUBR,[ ]01
;;; (ARRAY, SUBR, FSUBR, LSUBR, EXPR, FEXPR, MACRO, AUTOLOAD) MUST BE IN THAT ORDER
MKAT ARRAY,FSUBR,[ ]
MKAT SUBR,SUBR,[ ]1
IRP A,,[FSUBR,LSUBR,EXPR,FEXPR,MACRO]
MRA A
TERMIN
Q% MRA AUTOLOAD
;;; FOR QIO, (AUTOLOAD, ERRSET, *RSET-TRAP, GC-DAEMON,
;;; GC-OVERFLOW, PDL-OVERFLOW) MUST BE IN THAT ORDER
;;; NOTE THAT AUTOLOAD BELONGS TO SEQUENCE ABOVE ALSO
IFN QIO,[
MKAV AUTOLOAD,VAUTFN,QIALB,AUTOLOAD
MKFV ERRSET,ERRSET,FSUBR
MKAV *RSET-TRAP,V.TRAP,QCB,.R.TP
MKAV GC-DAEMON,VGCDAEMON
MKAV GC-OVERFLOW,VGCO,QGCOB,GCO
MKAV PDL-OVERFLOW,VPDL,QPDLB,PDL
] ;END OF IFN QIO
MRA [VALUE,LAMBDA,DSK,SYM,SPLICING,SINGLE,EVALARG,BPS]
MRA [BIBOP,FASL,JCL,LISP,DDT]
MSA GSYM,GLOBALSYM
IFN FUNAFL, MRA [LABEL,FUNARG]
IT$ MRA COM
IT$ MRA COMMON
10$ MRA SYS
SA$ MRA [MAC,LSP]
CMU$ MRA N920JW51
;;; (REGPDL, FLPDL, FXPDL, SPECPDL) MUST BE IN THAT ORDER
MRA [REGPDL,FLPDL,FXPDL,SPECPDL]
;;; NEED COPIES OF DOUBLE, COMPLEX, DUPLEX, BIGNUM EVEN IF TYPES NOT IMPLEMENTED
.SEE LDATER
DB% MRA DOUBLE
CX% MRA COMPLEX
DX% MRA DUPLEX
BG% MRA BIGNUM
HN% MRA HUNK
IT$ MRA ITS
10$ MRA DEC10
20$ MRA DEC20
T10$ MSA TOPS10,TOPS-10
20X MSA TOPS20,TOPS-20
10X MRA TENEX
CMU$ MRA CMU
MRA EXPERIMENTAL
IFN USELESS, MRA ROMAN
IFN SAIL+QIO, MRA SAIL
IFN JOBQIO, MRA JOB
IFN QIO, MRA [FILE,ECHO,CLA,IMAGE,BLOCK,NEWIO,OUTPUT,SCROLL]
20$ MRA MACLISP
Q$ IT$ MRA [.LISP.,SLAVE]
Q$ MSA RDEOF,READ-EOF
Q$ MSA CN.B,[↑B]
MSA M,[?]
MSA ..MIS,[**MISSING-ARG**]
MSA LA,[←]
MSA XPRHSH,EXPR-HASH
SUBTTL ATOMS FOR SUBRS
;DUMMY ATOM SO THAT BAKTRACE PRINTS SOMETHING REASONABLE IN CERTAIN SCREW CASES
MKAT1 QMARK,SUBR,,QMARK,0
MKAT GC,SUBR,,0
MKAT1 ↑G,SUBR,,CTRLG,0
;;; MUST HAVE (RUNTIME, TIME) IN THAT ORDER
MKAT1 RUNTIME,SUBR,[ ]$RUNTIME,0
MKAT TIME,SUBR,[ ]0
MKFV CAR,CAR,SUBR,,1
MKFV CDR,CDR,SUBR,,1
MKAT NTH,SUBR,,2
MKAT NTHCDR,SUBR,,2
IRPS A,C,[FIXP FLOATP RETURN EVALFRAME ERRFRAME,
BIGP,BOUNDP,LISTIFY
CAAR,CADR,CDAR,CDDR,CAAAR,CAADR,CADAR,CADDR,CDAAR,CDADR,
CDDAR,CDDDR,CAAAAR,CAAADR,CAADAR,CAADDR,CADAAR,CADADR,CADDAR,
CADDDR,CDAAAR,CDAADR,CDADAR,CDADDR,CDDAAR,CDDADR,CDDDAR,CDDDDR,
NOT,ATOM TYPEP,EXPLODE,MINUSP,PLUSP,NUMBERP ZEROP,
INTERN,LAST,REVERSE,NREVERSE,READLIST,MAKNAM,
LENGTH,ABS,MINUS,ADD1,SUB1,FIX,FLOAT,
FLATSIZE,FLATC,ARG COS,SQRT,LOG,EXP,
SXHASH,NOINTERRUPT,REMOB,SYSP,MAKUNBOUND,IMPLODE,MUNKAM
MAKNUM,SYMEVAL,PLIST,PURCOPY]
MKAT A,SUBR,[C]1
TERMIN
MKAT1 NCONS,SUBR,,$NCONS,1
MKAT1 SLEEP,SUBR,,$SLEEP,1
MKAT1 SIN,SUBR,,$SIN,1
IFN USELESS, MKAT HAULONG,SUBR,,1
IFE QIO,[
MKAT1 TYI,LSUBR,[ ]%TYI,01
MKAT1 TYO,SUBR,[ ]%TYO,1
MKAT1 PRINT,SUBR,[ ]PRINT,1
MKAT1 PRINC,SUBR,[ ]PRINC,1
MKFV TERPRI,%TERPRI,SUBR,,0
MKFV PRIN1,PRIN1,SUBR,,1
MKAT ERRPRINT,SUBR,,1
MKFV READ,OREAD,LSUBR,,01
MKAT1 READCH,LSUBR,[ ]$READCH,01
MKAT LISTEN,SUBR,,0
MKAV JPG|,VJPG ;***** CROCK FOR JPG *****
] ;END OF IFE QIO
IRPS A,C,[IFIX,EXPLODEC,NULL,ASCII ALLOC]
MKAT1 A,SUBR,[C]$!A,1
TERMIN
MKAT1 SYMBOLP,SUBR,,%SYMBOLP,1
MKAT1 EXPLODEN,SUBR,,$$EXPLODEN,1
MKAT1 ARRAYDIMS,SUBR,,ADIMS,1
MKAT1 PNGET,SUBR,,$PNGET,2
IRPS A,C,[SUBLIS REMPROP SET,RPLACA,RPLACD,
EQ,FRETURN,EXPT,MEMQ,SETARG MEMBER,EQUAL,GET,GETL,ASSOC,ASSQ,
REMAINDER,ATAN,SAMEPNAMEP,ALPHALESSP GETCHAR,COPYSYMBOL,PNPUT,
FILLARRAY NRECONC,SETPLIST]
MKAT A,SUBR,[C]2
TERMIN
MKAT1 XCONS,SUBR,,$XCONS,2
MKAT1 GETCHARN,SUBR,,$GETCHARN,2
IFN HNKLOG,[
MKAT CXR,SUBR,,2
MKAT MAKHUNK,SUBR,[ ]1
MKFV HUNKP,HUNKP,SUBR,TRUTH,1
MKAT HUNKSIZE,SUBR,,1
MKAT HUNK,LSUBR,[ ]
MKAT RPLACX,SUBR,,3
] ;END OF IFN HNKLOG
IFN USELESS,[
MKAT1 [\\]SUBR,,.GCD,2
IRPS A,C,[RECLAIM,HAIPART,GCD]
MKAT A,SUBR,[C]2
TERMIN
]
IFN USELESS*<1-QIO>,[
MKAT DUMPARRAYS,SUBR,,2
MKAT LOADARRAYS,SUBR,,1
] ;END OF IFN USELESS*<1-QIO>
IRPS A,,[LSH,ROT,FSC]
MKAT1 A,SUBR,,$!A,2
TERMIN
MKAT1 ↑,SUBR,,XPTII,2
MKAT1 ↑$,SUBR,,XPTI$,2
MKAT1 *BREAK,SUBR,,$BREAK,2
MKAT1 *THROW,SUBR,,.THROW,2
IRPS A,,[DIF,QUO]
MKAT1 [*A]SUBR,,.!A,2
TERMIN
IRP A,,[1+,1-]B,,[ADD1,SUB1]
IRP C,,[$,]D,,[$,I]
MKAT1 [A!!C]SUBR,,[D!!B]1
TERMIN
TERMIN
IRP A,,[>,<]B,,[GREAT,LESS]
MKAT1 A,SUBR,[ ]$!B,2
TERMIN
MKAT1 =,SUBR,,$EQUAL,2
MKAT1 [\]SUBR,,REMAINDER,2
IRPS A,C,[SASSOC,SASSQ,SETSYNTAX,SUBST]
MKAT A,SUBR,[C]3
TERMIN
MKFV PUTPROP,PUTPROP,SUBR,SBRL,3
IFN USELESS*ITS, MKAT1 PURIFY,SUBR,,$PURIFY,3
IFN LHFLAG, MKAT1 LH|,SUBR,,LHVBAR,2
SUBTTL ATOMS FOR FSUBRS AND LSUBRS
IRPS A,C,[COND PROG QUOTE DO DECLARE PROGV,
DEFPROP CATCH THROW BREAK GO ,
SETQ ERR SIGNP STORE STATUS SSTATUS FUNCTION CASEQ ]
MKAT A,FSUBR,[C]
TERMIN
IFE QIO,[
IRPS A,C,[CRUNIT UKILL UREAD UWRITE UFILE UCLOSE UAPPEND ,
UPROBE IOC IOG ]
MKAT A,FSUBR,[C]
TERMIN
] ;END OF IFE QIO
MKFV DEFUN,DEFUN,FSUBR,NIL
MKAT1 COMMENT,FSUBR,[ ]$COMMENT
MKAT1 UNWIND-PROTECT,FSUBR,[ ]UNWINP
MKAT1 *CATCH,FSUBR,[ ].CATCH
MKAT1 CATCHALL,FSUBR,,CATCHALL
MKAT1 CATCH-BARRIER,FSUBR,,CATCHB
MKAT1 AND,FSUBR,,$AND
MKAT1 OR,FSUBR,,$OR
IFN FUNAFL, MKAT1 *FUNCTION,FSUBR,[ ]%%FUNCTION
;;; MUST HAVE (MAPLIST,MAPCAR,MAP,MAPC,MAPCON,MAPCAN) IN THAT ORDER
MKAT MAPLIST,LSUBR,[ ]2777
MKAT MAPCAR,LSUBR,[ ]2777
MKAT1 MAP,LSUBR,[ ]$MAP,2777
MKAT MAPC,LSUBR,[ ]2777
MKAT MAPCON,LSUBR,[ ]2777
MKAT1 MAPCAN,LSUBR,[ ]$MAPCAN,2777
MKAT PROG2,LSUBR,[ ]2777
MKAT PROGN,LSUBR,[ ]
MKAT BOOLE,LSUBR,,2777
IRPS A,C,[DELQ DELETE APPLY ]
MKAT A,LSUBR,[C]23
TERMIN
IT$ MKAT SYSCALL,LSUBR,[ ]3777
;THIS IS FOR LSUBR CONS
; MKAT1 CONS,LSUBR,[ ]$CONS,1777
MKAT1 LIST*,LSUBR,[ ]$CONS,1777
;THIS IS FOR NON-LSUBR CONS
MKAT1 CONS,SUBR,,$C2NS,2
MKAT FUNCALL,LSUBR,[ ]1777
MKAT1 ARRAYCALL,FSUBR,[ ]%ARRAYCALL
MKAT SUBRCALL,FSUBR,[ ]
MKAT1 LSUBRCALL,FSUBR,[ ]%LSUBRCALL
IRPS A,C,[VALRET BAKTRACE BAKLIST GENSYM ]
MKAT A,LSUBR,[C]01
TERMIN
MKAT SUSPEND,LSUBR,[ ]02
Q% MKAT TYIPEEK,LSUBR,[ ]01
IFN USELESS*ITS,[
Q$ MKAT CURSORPOS,LSUBR,[ ]03
Q% MKAT CURSORPOS,LSUBR,[ ]02
] ;END OF IFN USELESS*ITS
MKAT QUIT,LSUBR,[ ]01
MKAT1 ERROR,LSUBR,[ ]$ERROR,03
MKAT GETSP,LSUBR,[ ]12
MKAT MAPATOMS,LSUBR,[ ]12
IRPS A,C,[NCONC PLUS,TIMES,DIFFERENCE,QUOTIENT,APPEND ]
MKAT A,LSUBR,[C]
TERMIN
;;; MUST HAVE (MAX,GREATERP,MIN,LESSP) IN THAT ORDER
MKAT MAX,LSUBR,[ ]1777
MKAT GREATERP,LSUBR,[ ]2777
MKAT MIN,LSUBR,[ ]1777
MKAT LESSP,LSUBR,[ ]2777
;;; IN THE FOLLOWING, NOTE THAT +, -, *, AND / GET VALUE CELLS
IRP A,,[+,-,*,/]B,,[PLUS,DIFFERENCE,TIMES,QUOTIENT]
MKFV [A]I!B,LSUBR,QI!B
TERMIN
IRP A,,[+,-,*,/]B,,[PLUS,DIFFERENCE,TIMES,QUOTIENT]
MKAT1 [A!$]LSUBR,,[$!B]
TERMIN
;;; THESE FOUR MUST BE IN THIS ORDER!
.SEE UINT32
MKAT ODDP,SUBR,[ ]1
MKFV EVAL,OEVAL,LSUBR,NIL,12
MKFV EVAL-WHEN,EWHEN,FSUBR,NIL,1
MKAT DEPOSIT,SUBR,[ ]2
MKAT EXAMINE,SUBR,[ ]1
MKAT1 *REARRAY,LSUBR,[ ].REARRAY,17
MKAT1 *ARRAY,LSUBR,[ ]%%ARRAY,27
MKAT LISTARRAY,LSUBR,[ ]12
;SYSTEM "MACROS"
MKAT1 PUSH,FSUBR,[ ]$PUSH
MKAT1 POP,FSUBR,[ ]$POP
MKAT DISPLACE,SUBR,,2
MKAT2 LET,LM
MKAT2 +INTERNAL-BACKQUOTE-MACRO,BQ,BACKQM
MSA BAQAUL,BACKQ
MKAT2 FORMAT,FT
SUBTTL ATOMS FOR LAP, FASLAP, AND FASLOAD USAGE
;;; SUBROUTINES USED BY COMPILER OUTPUT - ERGO, NEEDED BY LAP
;;; AND FASLOAD. ALSO OTHER GOODIES FOR LAP AND FASLAP.
IRP A,,[DELQ,DELETE,APPEND,TIMES,GREAT,LESS,PLUS,NCONC,APPLY]
MKAT1 *A,SUBR,[ ].!A,2
TERMIN
MKAT1 *CONS,SUBR,[ ]$C2NS,2
IRP A,,[PRINT,PRIN1,PRINC,TERPRI,TYO]B,,[PRT,PR1,PRC,TRP,TYO]C,,[1,1,1,0,1]
Q$ MKAT1 *!A,SUBR,[ ]B!$,C
Q% MSA B!$,*!A
TERMIN
IRP A,,[READ,READCH,TYI]B,,[READ,RDCH,TYI]C,,[0,0,0]
Q$ MKAT1 *!A,SUBR,[ ]B!$,C
Q% MSA B!$,*!A
TERMIN
MKAT1 *EVAL,SUBR,,EVAL,1
MKAV PURE,VPURE,IN1*PAGING ;INIT TO NIL OR 1 (IF PAGING SYS)
MKAV *PURE,V.PURE
MKAV PUzCLOBRL
MKAT1 FASLAPSETUP|,SUBR,,FSLSTP,1
MKFV LAPSETUP|,LAPSETUP,SUBR,,2
MKAT PAGEBPORG,SUBR,[ ]0
MKFV TTSR|,TTSR,SUBR
MKAT1 SQOZ|,SUBR,,5BTWD,1
MKAT GETDDTSYM,SUBR,[ ]1
MKAT PUTDDTSYM,SUBR,,2
MKFV GCPROTECT,GCPRO,SUBR,,2
MKAV SYMBOLS,V$SYMBOLS,,$SYMBOLS
MKFV FASLOAD,FASLOAD,FSUBR,SBRL
MKAT2 GRINDEF,GE,GFN
MKAT2 GRIND0,GI,GR0
IFN QIO*JOBQIO, MKAT2 LEDIT,LE
IFN QIO*JOBQIO, MRA LISPT
IFN QIO*JOBQIO, MKAT2 [INF-EDIT]LT,INF%ED
IFN QIO*ITS, MRA HUMBLE
IFN QIO*ITS, MKAT2 [CREATE-JOB]HM,CR%JOB
MKAT2 [LAP-A-LIST]LA,L%A%L
IRPS A,,[SPRINTER,GRIND,GETMIDASOP,LAP,TRACE,INDEX,SORT,SORTCAR
CGOL,CGOLREAD]B,,[GE,GI,GT,LA,TR,IN,SO,SO,CG,CG]
MKAT2 A,B
TERMIN
SA$ MKAT2 EREAD,ER
SA$ MKAT2 HELP,HE
IFN QIO*USELESS,[
IRP A,,[DUMPARRAYS,LOADARRAYS,ALLFILES,MAPALLFILES,DIRECTORY,MAPDIRECTORY]B,,[DA,DA,AL,AL,AL,AL]
MKAT2 A,B
TERMIN
] ;END OF IFN QIO*USELESS
SUBTTL ATOMS FOR ODDBALL FUNCTIONS AND VARIABLES
IFN <SAIL*<QIO-1>>+ITS, MKFV ALARMCLOCK,ALARMCLOCK,SUBR,,2
IFE <SAIL*<QIO-1>>+ITS, VALARM==VNIL
IFN QIO*USELESS,[ ;THESE MUST BE IN THIS ORDER, FOLLOWNG ALARMCLOCK
MKAV CLI-MESSAGE,VCLI,,CLI
MKAV MAR-BREAK,VMAR,,MAR
MKAV TTY-RETURN,VTTR,,TTR
MKAV SYS-DEATH,VSYSD,,SYSD
] ;END OF IFN QIO*USELESS
MKFV NOUUO,NOUUO,SUBR,,1
MKFV NORET,NORET,SUBR,,1
Q% MKFV ERRSET,ERRSET,FSUBR
MKFV EVALHOOK,EVALHOOK,LSUBR,,23
MKAV READ-*-EVAL-PRINT,VTLEVAL
MKAV READ-EVAL-*-PRINT,VTLPRINT
MKFV GCTWA,GCTWA,FSUBR
MKFV ARGS,ARGS,LSUBR,,12
MKFV *RSET,.RSET,SUBR,TRUTH,1
MKFV *NOPOINT,.NOPOINT,SUBR,,1
MKFV OBARRAY,OBARRAY,ARRAY,OBARRAY
MKFV READTABLE,READTABLE,ARRAY,READTABLE
IFN EDFLAG,[
MKFV EDIT,$EDIT,FSUBR,EDFUNL
MRA EDIT
MKAV [≠≠≠]VDLDLDL ;EDITOR'S LEFT LIST
MKAV [↑↑↑]EDUPLST ;EDITOR'S UP LIST
MKAV [≠≠]VDOLLAR,,DOLLAR
] ;END OF IFN EDFLAG
IFE EDFLAG, MKAT2 EDIT,ED
IFN QIO,[
SUBTTL ATOMS FOR NEWIO FUNCTIONS AND VARIABLES
IRPS A,C,[NAMELIST,NAMESTRING,SHORTNAMESTRING,TRUENAME INPUSH,PROBEF,LOAD FILEP]
MKAT A,SUBR,[C]1
TERMIN
MKFV DEFAULTF,DEFAULTF,SUBR,,1
MRA NODEFAULT
MKAT1 FORCE-OUTPUT,SUBR,[ ]FORCE,1
MKAT1 CLEAR-OUTPUT,SUBR,,CLROUT,1
MKAT1 CLEAR-INPUT,SUBR,,CLRIN,1
IRPS A,C,[CLOSE DELETEF IN FASLP ]
MKAT1 A,SUBR,[C]$!A,1
TERMIN
MKAT1 +TYO,SUBR,,PTYO,2
MKAT1 OPEN,LSUBR,[ ]$OPEN,04
SA$ MKAT1 EOPEN,LSUBR,[ ]$EOPEN,04
MKAT1 OUT,SUBR,[ ]$OUT,2
MKAT1 RENAMEF,SUBR,[ ]$RENAMEF,2
MKAT CNAMEF,SUBR,[ ]2
MKAT MERGEF,SUBR,,2
MKAT1 LENGTHF,SUBR,[ ]$LENGTHF,1
MKAT1 LISTEN,LSUBR,[ ]$LISTEN,01
IFN SFA,[
MKAT1 SFA-CREATE,SUBR,,STCREA,3
MKAT1 SFA-CALL,SUBR,,STCALL,3
MKAT1 SFAP,SUBR,,STPRED,1
MKAT1 SFA-GET,SUBR,,STGET,2
MKAT1 SFA-STORE,SUBR,,STSTOR,3
MSA WOP,WHICH-OPERATIONS
MRA FILEMODE
MRA UNTYI
MRA SFA
MRA PNAME
MRA NAME
MRA PROBEF
MRA TTYSCAN
MRA TTYCONS
] ;END IFN SFA
IRPS A,C,[CRUNIT,UKILL,UFILE UCLOSE,UAPPEND,UPROBE,INCLUDE]
MKAT A,FSUBR,[C]
TERMIN
MKFV UREAD,UREAD,FSUBR
MKFV UWRITE,UWRITE,FSUBR
IRPS A,,[INFILE,INSTACK,OUTFILES,ECHOFILES]C,,[TRUTH,,,]
MKAV A,,C
TERMIN
MKAV MSGFILES,,QTLIST,MSGFILES
MKFV TYI,%TYI,LSUBR,TTYIFA,02
MKAT1 READLINE,LSUBR,[ ]%READLINE,02
MKAT TYIPEEK,LSUBR,[ ]03
MKFV TYO,%TYO,LSUBR,TTYOFA,12
MKAT1 PRINT,LSUBR,[ ]%PRINT,12
MKFV PRIN1,%PR1,LSUBR,,12
MKAT1 PRINC,LSUBR,[ ]%PRC,12
MKFV TERPRI,%TERPRI,LSUBR,,01
MKFV READ,OREAD,LSUBR,,02
MKAT1 READCH,LSUBR,[ ]$READCH,02
IRPS A,C,[ENDPAGEFN EOFFN PAGEL CHARPOS LINENUM PAGENUM LINEL RUBOUT FILEPOS ERRPRINT ]
MKAT A,LSUBR,[C]12
TERMIN
] ;END OF IFN QIO
SUBTTL ATOMS FOR VARIABLES AND USER INTERRUPT BREAKS
;;; TTYOPN WILL INIT VLINEL TO THE RIGHT THINGS.
;;; FOR NON-BIBOP, NOTE THAT LINEL AND CHRCT POINT INTO THE
;;; (UNRELOCATED!) INUM AREA DURING ALLOC. THEY WILL THUS
;;; HAVE THE RIGHT VALUES BUT THE WRONG TYPE (I.E. TYPEP
;;; OF THEM WOULD LOSE.) THUS PRINT ETC. SHOULD NOT CHECK
;;; TYPEP OF THESE THINGS. ALLOC REHACKS THEIR VALUES AFTERWARDS.
;;; CHRCT IS INITIALLY 777 SO ALLOC WON'T GENERATE CR'S.
COMMENT | VBPORG: VBPEND: VERRLIST: VTTY: VZUNDERFLOW: VZFUZZ: VCHRCT: VLINEL: |
IRP A,,[BPEND,BPORG,ERRLIST,TTY,ZUNDERFLOW]C,,[VBPE1,VBP1,,,]
MKAV A,,C,A
TERMIN
BG$ MKAV ZFUZZ,,,ZFUZZ
Q% MKAV CHRCT,,IN777,CHRCT
Q% MKAV LINEL,,IN777,LINEL
COMMENT | VIBASE: VBASE: V%LEVEL: V%LENGTH: TAPRED: TTYOFF: TAPWRT: SIGNAL: |
;;; FOR NON-BIBOP, ALLOC REHACKS VBASE AND VIBASE AFTERWARDS.
MKAV IBASE,,IN10,IBASE
MKAV BASE,,IN10,BASE
IFN USELESS,[
MKAV PRINLEVEL,V%LEVEL,,%LEVEL
MKAV PRINLENGTH,V%LENGTH,,%LENGTH
] ;END OF IFN USELESS
IRP A,,[↑Q,↑W,↑R,↑A]B,,[TAPRED,TTYOFF,TAPWRT,SIGNAL]
MKAV A,B
TERMIN
Q% MKAV ↑B,LPTON
SA% MKAV [≠P]VDOLLRP,DOLLRP,DOLLRP
SA$ MKAV [}P]VDOLLRP,DOLLRP,DOLLRP
MKAV ↑D,GCGAGV,,CN.D
Q% MKAV ↑H,VCN.H,QCN.HB,CN.H
;;; FOR NON-QIO, (UNDF-FNCTN, UNBND-VRBL, WRNG-TYPE-ARG,
;;; UNSEEN-GO-TAG, WRNG-NO-ARGS, GC-LOSSAGE, FAIL-ACT)
;;; MUST BE IN THAT ORDER
;;; FOR QIO, (UNDF-FNCTN, UNBND-VRBL, WRNG-TYPE-ARG,
;;; UNSEEN-GO-TAG, WRNG-NO-ARGS, GC-LOSSAGE, FAIL-ACT,
;;; IO-LOSSAGE) MUST BE IN THAT ORDER
IRP A,,[UDF,UBV,WTA,UGT,WNA,GCL,FAC]PN,,[UNDF-FNCTN,UNBND-VRBL
WRNG-TYPE-ARG,UNSEEN-GO-TAG,WRNG-NO-ARGS,GC-LOSSAGE,FAIL-ACT]
MKAV PN,V!A,Q!A!B,A
TERMIN
Q% MKAV PDL-OVERFLOW,VPDL,QPDLB,PDL
Q% MKAV GC-OVERFLOW,VGCO,QGCOB,GCO
Q$ MKAV IO-LOSSAGE,VIOL,QIOLB,IOL
Q% MKAV GC-DAEMON,VGCDAEMON
Q% MKAV *RSET-TRAP,V.TRAP,QCB,.R.TP
MKAV COMPILER-STATE,VCOMST
Q$ MKAV MACHINE-ERROR,VMERR,,MERR
IFN MOBIOF,[
SUBTTL ATOMS FOR MOBY I/O FUNCTIONS
MKAT NEXTPLOT,SUBR,,0
IRPS A,C,[IMPX PLOT PLOTTEXT]
MKAT A,SUBR,[C]1
TERMIN
IRPS A,C,[OMPX MPX NVFIX NVID ]
MKAT A,SUBR,[C]2
TERMIN
MKAT NVSET,SUBR,,5
MKAT PLOTLIST,LSUBR,[ ]12
IRP A,,[DISCOPY,DISCRIBE,DISGORGE,DISGOBBLE,DISFRAME]
MKAT A,SUBR,,1
TERMIN
IRPS A,C,[DISBLINK,DISPLAY DISMARK]
MKAT A,SUBR,[C]2
TERMIN
IRP A,,[DISLINK,DISCHANGE,DISLOCATE]
MKAT A,SUBR,,3
TERMIN
MKAT DISMOTION,SUBR,,4
MKAT DISFLUSH,LSUBR
MKAT DISINI,LSUBR,,02
MKAT DISLIST,LSUBR,,01
MKAT DISCREATE,LSUBR,,02
MKAT DISAPOINT,LSUBR,,34
MKAT DISALINE,LSUBR,,35
MKAT DISCUSS,LSUBR,,45
MKAT DISET,LSUBR,,13
MKAV ↑F,DISON,,CN.F
MKAV ↑N,DISPON,,CN.N
IRP A,,[MPX,PLOT,PLOTLIST,NVFIX,NVSET]B,,[MX,MX,MX,NV,NV]
MKAT2 A,B
TERMIN
] ;END OF IFN MOBIOF
IFN ITS*QIO,[
MKAT2 DISINI,DS
MKAT2 SFTV|,NV,SFTV.
MKAT2 NVID,NV
] ;END IFN ITS
PGTOP ATM,[SYSTEM ATOMS AND STUFF]
;;; ************* END OF PURE LISP (NON-BIBOP) *************
PFSLAST==. ;GUARANTEED SAFE OVER SPCTOP
10$ $LOSEG
LOC C.
ESYSVC==.
EXPUNGE C.
SUBTTL RANDOM BINDABLE CELLS
;;; HERE ARE THINGS WHICH ARE LIKE VALUE CELLS, IN THAT SPECPDL
;;; UNBINDING MUST WORK ON THEM; BUT THEY ARE NOT NECESSARILY
;;; MARKED FROM.
LISAR: NIL ;LAST INTERPRETIVELY-SEEN ARRAY - ASAR
IFE QIO,[
VCN.AT: NIL ;INTERRUPT FUN FOR ↑@
VICA: NIL ; " ↑A
VIC34: NIL ; " ↑\
VIC35: NIL ; " CONTROL RIGHT BRACKET
VIC36: NIL ; " ↑↑
VAUTFN: QIALB ;AUTOLOAD FUNCTION
] ;END OF IFE QIO
IFE QIO,[
TYIMAN: NIL ;IT'S....... TYI-MAN!
;FASTER THAN A SPEEDING IMLAC!
;MORE POWERFUL THAN A TECOMOTIVE!
;ABLE TO LEAP TALL FUNCTIONS WITH A SINGLE JRST!
;YES, IT'S TYI-MAN! WHO, IN HIS NORMAL IDENTITY AS
; CLARK NIL (A NAMELESS NOBODY), IS EVER-READY TO
; ASSUME A SECRET SUPER-IDENTITY TO PROTECT AND SERVE
; FREEDOM, JUSTICE, AND THE HIRSUTE READER!!!!!!!!
TMBBC: 0 ;ROBIN, TYIMAN'S BIRD-BRAINED COMPANION!
;WOULD YOU BELIEVE TYIMAN'S BUFFERED-BACK CHARACTER?
] ;END OF IFE QIO
IFN QIO,[
TYIMAN: $DEVICE ;WHERE TO GET CHARACTERS FROM
UNTYIMAN: UNTYI ;WHERE TO PUT BACK CHARACTERS TO
UNREADMAN: .+1
.VALUE
; UNRD ;WHERE TO PUT BACK FORMS TO
READPMAN: .+1
.VALUE
; READP ;WHERE TO GO TO CHECK FOR PENDING FORMS
] ;END OF IFN QIO
FASLP: NIL ;FASLOADING-P?
TIRPATE: 0 ;PSEUDO VALUE CELL, USED TO EXTIRPATE THE CONSEQUENT UNBINDING
;FOLLOWING A SETQ DONE ON NIL OR T
;;; #### MOOOBY IMPORTANT! MUST HAVE <ADDRESS OF ARGNUM> = <ADDRESS OF ARGLOC> + 1
ARGLOC: 0 ;FOR LEXPRS - LOCATION OF ARG VECTOR ON PDL
ARGNUM: 0 ;HOLDS FIXNUM WHICH IS # OF ARGS FOR LEXPR IN ARGLOC
SUBTTL BIBOP STORAGE PARAMETER CALCULATIONS
BFVCS:
INFVCS==BXVCSG-BFVCS
IFL INFVCS, WARN \-INFVCS,[=TOO MANY VALUE CELLS]
SPCTOP VC,ILS,[VALUE CELL]
LOC S.
EXPUNGE S. B.
IFL ESYMGS-1-., WARN \.-ESYMGS,[=TOO MANY SYMBOLS (SYMEST=]\SYMEST,[)]
SYMSYL==:. ;ADR OF LAST SYSTEM SYM
SPCTOP SYM,ILS,[SYMBOL HEADER]
IFN D10,[
NXXASG==0
NXXZSG==0
$HISEG
] ;END OF IFN D10
IFN ITS+D20,[
BXXASG==.
NXXASG==<<<BXXASG+PAGSIZ-1>&PAGMSK>-BXXASG>/SEGSIZ
BXXZSG==BXXASG+NXXASG*SEGSIZ ;TAKE UP SLACK PAGES BEFORE SY2
NXXZSG==<BSY2SG-BXXZSG>/SEGSIZ
] ;END OF IFN ITS+D20
NSY2SG==<BPFXSG-BSY2SG>/SEGSIZ
SEGUP BSY2SG+NSY2SG*SEGSIZ-1
SPCTOP SY2,ILS,[PURE SYMBOL BLOCK]
LOC F.
EXPUNGE F.
IFL EPFXGS-1-HINUM-LONUM-., WARN \.+HINUM+LONUM-EPFXGS,[=TOO MANY PURE FIXNUMS (PFXEST=]\PFXEST,[)]
ZZ==EPFXGS-.
ZZZ==<ZZ-HINUM-LONUM>/2 ; THEN TO THE NEXT PAGE BOUNDARY
XHINUM==HINUM+ZZZ ;DISTRIBUTE ANY SUCH EXTRA SPACE EVENLY
IFL XHINUM-777,XHINUM==777 ;MANY LOSERS DEPEND ON HINUM BEING AT LEAST THIS BIG
XLONUM==ZZ-XHINUM ; BETWEEN POSITIVE AND NEGATIVE INUMS
IFL XLONUM-10,[
WARN [XLONUM=]\XLONUM,[, YOU WILL CERTAINLY LOSE]
.ERR INUM LOSSAGE
]
REPEAT XLONUM, .RPCNT-XLONUM
IN0: ;HAIRY PAGE (APPROXIMATELY) OF SMALL FIXNUMS
REPEAT XHINUM, .RPCNT
IRP X,,[1,2,3,4,5,6,7,10,777]
IN!X=IN0+X
TERMIN
INFORM [HIGHEST NLISP INUM=]\XHINUM
INFORM [LOWEST NLISP INUM=-]\XLONUM
SPCTOP PFX,ILS,[PURE FIXNUM]
LOC PFSLAST
SPCTOP PFS,ILS,[PURE LIST]
SPCBOT PFL
;;; INITIAL ASSEMBLED PURE FLONUMS GO HERE (HA HA!)
SPCTOP PFL,ILS,[PURE FLONUM]
10$ $LOSEG
SUBTTL INITIAL RANDOM IMPURE FREE STORAGE
IFN ITS+D20,[
BXXPSG==. ;POSSIBLE SLACK PURE SEGMENT
PAGEUP
NXXPSG==<.-BXXPSG>/SEGSIZ
SPCBOT IFS
NPURFS==<.-BPURFS>/PAGSIZ
] ;END OF IFN ITS+D20
.ELSE, SPCBOT IFS
FIRSTW:
QXSET1: .,,NIL ;FOR XSETQ
NUNMRK==.-FIRSTW .SEE GCP6
IFG NUNMRK-40, WARN \NUNMRK,[=TOO MANY UNMARKABLE FS LOCATIONS]
FEATEX: QEXPERIMENTAL %
FEATLS: ;INITIAL LIST FOR (STATUS FEATURES)
QBIBOP %
IFN BIGNUM, QBIGNUM %
IFN EDFLAG, QEDIT %
QFASLOAD %
IFN HNKLOG, QHUNK %
IFN FUNAFL, QFUNARG %
IFN USELESS, QROMAN %
IFN QIO, QNEWIO %
IFN MOBIOF, QCN.F %
IFN SFA, QSFA %
;PENULTIMATE IS DEC10/DEC20, OR ITS MACHINE NAME
IT$ MACHFT: NIL % ;STARTUP PUTS MACHINE NAME HERE
10$ QDEC10 %
20$ QDEC20 %
;OPERATING SYSTEM COMES LAST
IT$ QITS,,NIL
T10$ QTOPS10,,NIL
20X QTOPS20,,NIL
SA$ QSAIL,,NIL
10X QTENEX,,NIL
CMU$ QCMU,,NIL
;;; FROM BPROTECT, FOR DISTANCE LPROTECT, IS PROTECTED BY THE GARBAGE COLLECTOR.
.SEE GCP6Q2
BPROTECT:
BG$ BNV1,,ARGNUM ;TO PROTECT CONTENTS OF THESE CELLS
BG% NIL,,ARGNUM
TLF: NIL ;TOP LEVEL FORM - NIL FOR STANDARD
BLF: NIL ;ANALOGOUSLY, THE BREAK LEVEL FORM
QF1SB: NIL ;SAVE B DURING QF1
PA3: 0 ;RH = PROG BODY (I.E. CDDR OF PROG FORM)
;LH = NEXT PROG STATEMENT
GCPSAR: 0 ;POINTS TO SAR FOR HASH ARRAY FOR GC-PROTECTION LISTS
IFE QIO,[
RDTYBF: 0 ;SIMULATED TTY BUFF (FS LIST)
MKNM3: NIL ;HOLDS LIST OF CHARS TO BE READLISTED
URUNIT: NIL ;LAST ARG TO UREAD
UWUNIT: NIL ;LAST ARG TO UWRITE
IUNIT: NIL ;"CRUNIT"
] ;END OF IFE QIO
Q$ RDLARG: NIL ;LIST OF CHARS FOR READLIST, MAKNAM, IMPLODE
IFN EDFLAG, EDSRCH: NIL ;SAVED SEARCH LIST
IFN MOBIOF, FTVU: NIL ;IF FAKE TV IS IN USE, HAS (G0001 DSK VIS) ?
IFN MOBIOF, FTVBL: NIL ;LIST OF BLOCKS CURRENTLY RESIDENT IN BUFFERS - LAST OF LIST IN LH
SUDIR: NIL ;INITIAL SNAME (ITS) OR PPN (DEC-10)
FEATURES: FEATLS
LDFNAM: NIL ;FASLOAD FILE NAME
LDEVPRO: NIL ;LIST OF EVALED-FROBS-IN-ATOMTABLE TO BE PROTECTED
NILPROPS: NIL ;PROPERTY LIST FOR NIL
IFN QIO,[
DEOFFN: NIL ;DEFAULT EOF FUNCTION
DENDPAGEFN: NIL ;DEFAULT END OF PAGE FUNCTION
] ;END OF IFN QIO
LPROTECT==:.-BPROTECT
Q.=:QITIMES ;ALIASES FOR THE SYMBOL *
V.=:VITIMES
.HKILL QITIMES VITIMES
IFN EDFLAG, DOLLAR=QDOLLAR
DOLLRP=QDOLLRP
Q% IGCMKL==NIL ;INITIAL GCMKL
IFN QIO,[ ;INITIAL GCMKL
IGCMKL: DEDSAR % ;DEAD AREA AT TOP OF BPS
IGCFX1 %
INIIFA % ;INIT FILE ARRAY
IGCFX2,,NIL
] ;END OF IFN QIO
OBTFS: BLOCK KNOB+10 ;FREE STORAGE FOR OBARRAY CONSAGE
LFSALC==100
FSALC: BLOCK LFSALC ;FOR ALLOC
SPCTOP IFS,ILS,[IMPURE LIST]
SPCBOT IFX
BG$ BNV1: . ;TEMPORARILY RPLACED BY BNCVTM
VBP1: ;INITIAL ALLOCATED VALUE FOR BPORG
BBPSSG
VBPE1: ;INITIAL ALLOCATED VALUE FOR BPEND
Q% IT$ <<ENDLISP+PAGSIZ-1>&PAGMSK>-1
Q% 10$ ENDLISP
Q$ INIIF1-2
IFN QIO,[
IGCFX1:
10% <<ENDLISP+PAGSIZ-1>&PAGMSK>-EINIFA ;SIZE OF DEAD BLOCK
10$ 0 ;WILL BE CALCULATED BY ALLOC
IGCFX2: LINIFA ;SIZE OF INIT FILE ARRAY
] ;END OF IFN QIO
LFWSALC==40
FWSALC: BLOCK LFWSALC ;FOR ALLOC
NIFWAL==0
SPCTOP IFX,ILS,[IMPURE FIXNUM]
SPCBOT IFL
0 ;NEED AT LEAST ONE IMPURE FLONUM SEGMENT
SPCTOP IFL,ILS,[IMPURE FLONUM]
IFN BIGNUM,[
SPCBOT BN
BBIGPRO: .SEE GCP6Q3 ;PROTECTED BIGNUMS
BN235: 0,,BNM23A
BNM235: -1,,BNM23A
BNM236: -1,,BNM23B
BNV2: 0,,BNV2A
BN.1: 0,,BN.1A
LBIGPRO==.-BBIGPRO
SPCTOP BN,ILS,[BIGNUM]
] ;END OF IFN BIGNUM
IFE BIGNUM,[
BBNSG==.
NBNSG==0
] ;END OF IFE BIGNUM
IFE D10,[
BXXBSG==. ;TAKE UP SLACK UNTIL FIRST PAGE OF BPS
PAGEUP
NXXBSG==<.-BXXBSG>/SEGSIZ
] ;END OF IFE D10
IF2 GEXPUN
BLSTIM==.MRUNT-BLSTIM
INFORM [TIME TO MAKE INITIAL STRUCT, PASS ]\.PASS,[ = ]\BLSTIM/1000.,[ SECS]
ββββ